
#include <assert.h>

#include "utility/olisp_utils.h"
#include "utility/olisp_helpers.h"
#include "functions/olisp_lf_arith.h"

static int extract_two_num_args(
    interpreter_t *     interp,
    list_obj_t *  args,
    num_obj_t **  lhs,
    num_obj_t **  rhs
    )
{
    obj_t * l;
    obj_t * r;

    do
    {
        if( list_length(args) != 3 )
            break;

        l = list_get_elem( args, 1 );
        r = list_get_elem( args, 2 );

        if( l->vtbl->element_type != LISP_ELEM_NUMBER ||
            r->vtbl->element_type != LISP_ELEM_NUMBER )
        {
            break;
        }

        *lhs = (num_obj_t *)l;
        *rhs = (num_obj_t *)r;

        return 1;
    }
    while( 0 );

    interpreter_message( interp, MSG_SEV_ERROR, (obj_t *)args,
        "operation expects two numeric arguments" );
    return 0;
}

#define ARITH_BINARY_LOGIC_OP_IMPL( func_name, OP ) \
    static obj_t * func_name( \
        interpreter_t * interp, \
        list_obj_t * args ) \
    { \
        num_obj_t * lhs; \
        num_obj_t * rhs; \
        if( !extract_two_num_args(interp, args, &lhs, &rhs) ) \
            return 0; \
        if( num_is_double(lhs) || num_is_double(rhs) ) \
        { \
            return (num_as_double(lhs) OP num_as_double(rhs)) ? true_elem : nil_elem; \
        } \
        return (num_as_int(lhs) OP num_as_int(rhs)) ? true_elem : nil_elem; \
    }

ARITH_BINARY_LOGIC_OP_IMPL( lf_greater, > );
ARITH_BINARY_LOGIC_OP_IMPL( lf_less, < );
ARITH_BINARY_LOGIC_OP_IMPL( lf_not_less, >= );
ARITH_BINARY_LOGIC_OP_IMPL( lf_not_greater, <= );
ARITH_BINARY_LOGIC_OP_IMPL( lf_eq, == );
ARITH_BINARY_LOGIC_OP_IMPL( lf_not_eq, == );

//static void non_numeric_arg_in_function( interpreter_t * interp, list_obj_t * args, )

#define NUMERIC_OP_IMPL( func_name, OP ) \
    static obj_t * func_name( \
        interpreter_t *     interp, \
        list_obj_t *  args ) \
    { \
        int     is_double = 0; \
        int     int_val = 0; \
        double  dbl_val = .0; \
        size_t  n; \
        size_t  len = list_length( args ); \
        if( len < 3 ) \
        { \
            interpreter_message( interp, MSG_SEV_ERROR, (obj_t *)args, \
                "function expects two or more arguments" ); \
            return 0; \
        } \
        for( n = 1; n < list_length(args); ++ n ) \
        { \
            num_obj_t * arg = (num_obj_t *)list_get_elem( args, n ); \
            /* check whether conversion above is valid */ \
            if( arg->vtbl->element_type != LISP_ELEM_NUMBER ) \
            { \
                interpreter_message( interp, MSG_SEV_ERROR, (obj_t *)arg, \
                    "non-numeric elements in function" ); \
                return 0; \
            } \
            /* do operation depending on the number's type */ \
            if( is_double ) \
            { \
                dbl_val OP##= num_as_double( arg ); \
            } \
            else \
            { \
                if( num_is_double(arg) ) \
                { \
                    is_double = 1; \
                    dbl_val = (double)int_val; \
                    dbl_val OP##= num_as_double( arg ); \
                } \
                else \
                { \
                    int_val OP##= num_as_int( arg ); \
                } \
            } \
        } \
        if( is_double ) \
        { \
            return (obj_t *)create_dbl_number( dbl_val ); \
        } \
        return (obj_t *)create_int_number( int_val ); \
    }

NUMERIC_OP_IMPL( lf_add, + );
NUMERIC_OP_IMPL( lf_mul, * );


static obj_t * lf_sub(
    interpreter_t *     interp,
    list_obj_t *  args )
{
    int     is_double;
    int     int_val;
    double  dbl_val;
    num_obj_t * arg;
    size_t  n;
    size_t  len = list_length( args );

    if( len < 3 )
    {
        interpreter_message( interp, MSG_SEV_ERROR, (obj_t *)args,
            "function expects two or more arguments" );
        return 0;
    }

    arg = (num_obj_t *)list_get_elem( args, 1 );
    if( arg->vtbl->element_type != LISP_ELEM_NUMBER )
    {
        interpreter_message( interp, MSG_SEV_ERROR, (obj_t *)arg,
            "non-numeric elements in function" );
        return 0;
    }

    if( num_is_double(arg) )
    {
        is_double = 1;
        dbl_val = num_as_double( arg );
        int_val = 0;
    }
    else
    {
        is_double = 0;
        int_val = num_as_int( arg );
        dbl_val = .0;
    }

    for( n = 2; n < list_length(args); ++ n )
    {
        arg = (num_obj_t *)list_get_elem( args, n );
        /* check whether conversion above is valid */
        if( arg->vtbl->element_type != LISP_ELEM_NUMBER )
        {
            interpreter_message( interp, MSG_SEV_ERROR, (obj_t *)arg,
                "non-numeric elements in function" );
            return 0;
        }
        /* do operation depending on the number's type */
        if( is_double )
        {
            dbl_val -= num_as_double( arg );
        }
        else
        {
            if( num_is_double(arg) )
            {
                is_double = 1;
                dbl_val = (double)int_val;
                dbl_val -= num_as_double( arg );
            }
            else
            {
                int_val -= num_as_int( arg );
            }
        }
    }
    if( is_double )
    {
        return (obj_t *)create_dbl_number( dbl_val );
    }
    return (obj_t *)create_int_number( int_val );
}

LISP_REGISTRATION_FUNC_BEGIN( register_lf_arith )
    LISP_REGISTER_FUNC( ">",    &lf_greater )
    LISP_REGISTER_FUNC( "<",    &lf_less )
    LISP_REGISTER_FUNC( ">=",   &lf_not_less )
    LISP_REGISTER_FUNC( "<=",   &lf_not_greater )
    LISP_REGISTER_FUNC( "=",    &lf_eq )
    LISP_REGISTER_FUNC( "!=",   &lf_not_eq )

    LISP_REGISTER_FUNC( "+", &lf_add )
    LISP_REGISTER_FUNC( "-", &lf_sub )
    LISP_REGISTER_FUNC( "*", &lf_mul )
LISP_REGISTRATION_FUNC_END()
